unit Patches;

interface
uses SysUtils, Classes, Windows, Messages, Controls, Forms, Themes, Graphics,
     System.Types;

type
  TScrollingStyleHookPatch = class(TMouseTrackControlStyleHook)
  strict private type
    {$REGION 'TScrollWindow'}
    TScrollWindow = class(TWinControl)
    strict private
      FStyleHook: TScrollingStyleHookPatch;
      FVertical: Boolean;
      procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
      procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
      procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    strict protected
      procedure CreateParams(var Params: TCreateParams); override;
      procedure WndProc(var Message: TMessage); override;
    public
      constructor Create(AOwner: TComponent); override;
      property StyleHook: TScrollingStyleHookPatch read FStyleHook write FStyleHook;
      property Vertical: Boolean read FVertical write FVertical;
    end;
    {$ENDREGION}
  strict private
    FHorzDownState: TThemedScrollBar;
    FHorzScrollWnd: TScrollWindow;
    FHorzSliderState: TThemedScrollBar;
    FHorzUpState: TThemedScrollBar;
    FLeftButtonDown: Boolean;
    FListPos: Single;
    FPrevScrollPos: Integer;
    FScrollPos: Single;
    FVertDownState: TThemedScrollBar;
    FVertScrollWnd: TScrollWindow;
    FVertSliderState: TThemedScrollBar;
    FVertUpState: TThemedScrollBar;
    FInitingScrollBars: Boolean;
    function GetHorzDownButtonRect: TRect;
    function GetHorzScrollRect: TRect;
    function GetHorzSliderRect: TRect;
    function GetHorzTrackRect: TRect;
    function GetHorzUpButtonRect: TRect;
    function GetParentBounds: TRect;
    function GetVertDownButtonRect: TRect;
    function GetVertScrollRect: TRect;
    function GetVertSliderRect: TRect;
    function GetVertTrackRect: TRect;
    function GetVertUpButtonRect: TRect;
    function IsPopupWindow: Boolean;
    procedure InitScrollBars;
    procedure InitScrollState;
    procedure UpdateScroll;
    procedure CMVisibleChanged(var Msg: TMessage); message CM_VISIBLECHANGED;
    procedure WMKeyDown(var Msg: TMessage); message WM_KEYDOWN;
    procedure WMKeyUp(var Msg: TMessage); message WM_KEYUP;
    procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP;
    procedure WMNCLButtonDown(var Msg: TWMMouse); message WM_NCLBUTTONDOWN;
    procedure WMNCMouseMove(var Msg: TWMMouse); message WM_NCMOUSEMOVE;
    procedure WMNCLButtonUp(var Msg: TWMMouse); message WM_NCLBUTTONUP;
    procedure WMMouseMove(var Msg: TWMMouse); message WM_MOUSEMOVE;
    procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL;
    procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;
    procedure WMHScroll(var Msg: TMessage); message WM_HSCROLL;
    procedure WMSize(var Msg: TMessage); message WM_SIZE;
    procedure WMMove(var Msg: TMessage); message WM_MOVE;
    procedure WMCaptureChanged(var Msg: TMessage); message WM_CAPTURECHANGED;
    procedure WMNCLButtonDblClk(var Msg: TWMMouse); message WM_NCLBUTTONDBLCLK;
    procedure WMWindowPosChanged(var Msg: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure WMShowWindow(var Msg: TWMShowWindow); message WM_SHOWWINDOW;
    procedure WMClose(var Msg: TWMCLOSE); message WM_CLOSE;
    function GetControlClientRect: TRect;
  strict protected
    procedure DrawBorder; virtual;
    procedure DrawHorzScroll(DC: HDC); virtual;
    procedure DrawVertScroll(DC: HDC); virtual;
    procedure PaintBackground(Canvas: TCanvas); override;
    procedure PaintScroll; virtual;
    procedure Paint(Canvas: TCanvas); override;
    procedure PaintNC(Canvas: TCanvas); override;
    procedure MouseLeave; override;
    procedure WndProc(var Message: TMessage); override;
    property HorzDownButtonRect: TRect read GetHorzDownButtonRect;
    property HorzDownState: TThemedScrollBar read FHorzDownState write FHorzDownState;
    property HorzScrollRect: TRect read GetHorzScrollRect;
    property HorzSliderRect: TRect read GetHorzSliderRect;
    property HorzSliderState: TThemedScrollBar read FHorzSliderState write FHorzSliderState;
    property HorzTrackRect: TRect read GetHorzTrackRect;
    property HorzUpButtonRect: TRect read GetHorzUpButtonRect;
    property HorzUpState: TThemedScrollBar read FHorzUpState write FHorzUpState;
    property LeftButtonDown: Boolean read FLeftButtonDown;
    property ListPos: Single read FListPos write FListPos;
    property ParentBounds: TRect read GetParentBounds;
    property PrevScrollPos: Integer read FPrevScrollPos write FPrevScrollPos;
    property ScrollPos: Single read FScrollPos write FScrollPos;
    property VertDownButtonRect: TRect read GetVertDownButtonRect;
    property VertDownState: TThemedScrollBar read FVertDownState write FVertDownState;
    property VertScrollRect: TRect read GetVertScrollRect;
    property VertSliderRect: TRect read GetVertSliderRect;
    property VertSliderState: TThemedScrollBar read FVertSliderState write FVertSliderState;
    property VertTrackRect: TRect read GetVertTrackRect;
    property VertUpButtonRect: TRect read GetVertUpButtonRect;
    property VertUpState: TThemedScrollBar read FVertUpState write FVertUpState;
  public
    constructor Create(AControl: TWinControl); override;
    destructor Destroy; override;
  end;

implementation

{ TScrollingStyleHook }

constructor TScrollingStyleHookPatch.Create(AControl: TWinControl);
begin
  inherited;
  OverridePaintNC := True;
  FVertScrollWnd := nil;
  FHorzScrollWnd := nil;
  FInitingScrollBars := False;
end;

destructor TScrollingStyleHookPatch.Destroy;
begin
  FInitingScrollBars := True;
  if FVertScrollWnd <> nil then
  begin
    FVertScrollWnd.StyleHook := nil;
    FreeAndNil(FVertScrollWnd);
  end;
  if FHorzScrollWnd <> nil then
  begin
    FHorzScrollWnd.StyleHook := nil;
    FreeAndNil(FHorzScrollWnd);
  end;
  FInitingScrollBars := False;
  inherited;
end;

function TScrollingStyleHookPatch.IsPopupWindow;
begin
  Result := (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = WS_EX_TOOLWINDOW) or
            (GetWindowLong(Handle, GWL_STYLE) and WS_POPUP = WS_POPUP);
end;

function TScrollingStyleHookPatch.GetControlClientRect: TRect;
var Msg: TWMNCCalcSize;
    SendMsg: TMessage absolute Msg;
begin
  Msg.Msg := WM_NCCALCSIZE;
  Msg.CalcValidRects := false;
  new(Msg.CalcSize_Params);
  try
    Msg.CalcSize_Params^.rgrc[0].Left := Control.Left;
    Msg.CalcSize_Params^.rgrc[0].Top := Control.Top;
    Msg.CalcSize_Params^.rgrc[0].Width := Control.Width;
    Msg.CalcSize_Params^.rgrc[0].Height := Control.Height;
    Control.Perform(WM_NCCALCSIZE, SendMsg.WParam, SendMsg.LParam);
    Result := Msg.CalcSize_Params^.rgrc[0];
    Dec(Result.Left, Control.Padding.Left);
    Dec(Result.Top, Control.Padding.Top);
    Inc(Result.Right, Control.Padding.Right);
    Inc(Result.Bottom, Control.Padding.Bottom);
  finally
    Dispose(Msg.CalcSize_Params);
  end;
end;

procedure TScrollingStyleHookPatch.InitScrollBars;
var
  R, CtrlRect: TRect;
begin
  if FInitingScrollBars then Exit;

  FInitingScrollBars := True;

  InitScrollState;
  CtrlRect := GetControlClientRect;

  FVertScrollWnd := TScrollWindow.CreateParented(GetParent(Control.Handle));
  FVertScrollWnd.StyleHook := Self;
  FVertScrollWnd.Vertical := True;
  R := VertScrollRect;
  if (Control.BiDiMode = bdRightToLeft) and not IsRectEmpty(R) then
  begin
    OffsetRect(R, -R.Left, 0);
    if HasBorder then
      if HasClientEdge then
        OffsetRect(R, 2, 0)
      else
        OffsetRect(R, 1, 0);
  end;
  with R do
   if IsPopupWindow then
     SetWindowPos(FVertScrollWnd.Handle, HWND_TOPMOST,
       CtrlRect.Left + Left, CtrlRect.Top + Top,
         Right - Left, Bottom - Top, SWP_NOREDRAW)
   else
     SetWindowPos(FVertScrollWnd.Handle, HWND_TOP, CtrlRect.Left + Left, CtrlRect.Top + Top,
       Right - Left, Bottom - Top, SWP_NOREDRAW);

  if IsRectEmpty(VertScrollRect) then
    ShowWindow(FVertScrollWnd.Handle, SW_HIDE)
  else
    ShowWindow(FVertScrollWnd.Handle, SW_SHOW);

  FHorzScrollWnd := TScrollWindow.CreateParented(GetParent(Control.Handle));
  FHorzScrollWnd.StyleHook := Self;
  FHorzScrollWnd.Vertical := False;

  R := HorzScrollRect;
  if (Control.BiDiMode = bdRightToLeft) and not IsRectEmpty(VertScrollRect) then
    OffsetRect(R, VertScrollRect.Width, 0);
  with R do
    if IsPopupWindow then
      SetWindowPos(FHorzScrollWnd.Handle, HWND_TOPMOST,
        CtrlRect.Left + Left, CtrlRect.Top + Top,
          Right - Left, Bottom - Top, SWP_NOREDRAW)
    else
      SetWindowPos(FHorzScrollWnd.Handle, HWND_TOP, CtrlRect.Left + Left, CtrlRect.Top + Top,
        Right - Left, Bottom - Top, SWP_NOREDRAW);

  if IsRectEmpty(HorzScrollRect) then
    ShowWindow(FHorzScrollWnd.Handle, SW_HIDE)
  else
    ShowWindow(FHorzScrollWnd.Handle, SW_SHOW);

  FInitingScrollBars := False;
end;

procedure TScrollingStyleHookPatch.MouseLeave;
begin
  inherited;
  if VertSliderState = tsThumbBtnVertHot then
    FVertSliderState := tsThumbBtnVertNormal;

  if FHorzSliderState = tsThumbBtnHorzHot then
    FHorzSliderState := tsThumbBtnHorzNormal;

  if FVertUpState = tsArrowBtnUpHot then
    FVertUpState := tsArrowBtnUpNormal;

  if FVertDownState = tsArrowBtnDownHot then
    FVertDownState := tsArrowBtnDownNormal;

  if FHorzUpState = tsArrowBtnLeftHot then
    FHorzUpState := tsArrowBtnLeftNormal;

  if FHorzDownState = tsArrowBtnRightHot then
    FHorzDownState := tsArrowBtnRightNormal;

  PaintScroll;
end;

procedure TScrollingStyleHookPatch.PaintNC(Canvas: TCanvas);
begin
  if FInitingScrollBars then Exit;
  inherited;
  DrawBorder;
  if FVertScrollWnd = nil then
    InitScrollBars;
  UpdateScroll;
  PaintScroll;
end;

procedure TScrollingStyleHookPatch.InitScrollState;
begin
  FVertSliderState := tsThumbBtnVertNormal;
  FVertUpState := tsArrowBtnUpNormal;
  FVertDownState := tsArrowBtnDownNormal;
  FHorzSliderState := tsThumbBtnHorzNormal;
  FHorzUpState := tsArrowBtnLeftNormal;
  FHorzDownState := tsArrowBtnRightNormal;
end;

procedure TScrollingStyleHookPatch.UpdateScroll;
var
  R, CtrlRect: TRect;
begin
  CtrlRect := GetControlClientRect;
  if (FVertScrollWnd <> nil) and (FVertScrollWnd.HandleAllocated) then
  begin
    R := VertScrollRect;
    if (Control.BiDiMode = bdRightToLeft) and not IsRectEmpty(R) then
    begin
      OffsetRect(R, -R.Left, 0);
      if HasBorder then
        if HasClientEdge then
          OffsetRect(R, 2, 0)
        else
          OffsetRect(R, 1, 0);
    end;

    if IsRectEmpty(R) then
      ShowWindow(FVertScrollWnd.Handle, SW_HIDE)
    else
    begin
      ShowWindow(FVertScrollWnd.Handle, SW_SHOW);
      with R do
        if IsPopupWindow then
          SetWindowPos(FVertScrollWnd.Handle, HWND_TOPMOST,
            CtrlRect.Left + Left, CtrlRect.Top + Top,
              Right - Left, Bottom - Top, SWP_SHOWWINDOW)
        else
          SetWindowPos(FVertScrollWnd.Handle, HWND_TOP, CtrlRect.Left + Left,
           CtrlRect.Top + Top, Right - Left, Bottom - Top, SWP_SHOWWINDOW);
    end
  end;
  if (FHorzScrollWnd <> nil) and (FHorzScrollWnd.HandleAllocated) then
  begin
    R := HorzScrollRect;
    if (Control.BiDiMode = bdRightToLeft) and not IsRectEmpty(VertScrollRect) then
      OffsetRect(R, VertScrollRect.Width, 0);
    if IsRectEmpty(R) then
      ShowWindow(FHorzScrollWnd.Handle, SW_HIDE)
    else
    begin
      ShowWindow(FHorzScrollWnd.Handle, SW_SHOW);
      with R do
        if IsPopupWindow then
        begin
          SetWindowPos(FHorzScrollWnd.Handle, HWND_TOPMOST, CtrlRect.Left + Left,
            CtrlRect.Top + Top, Right - Left, Bottom - Top, SWP_SHOWWINDOW)
        end
        else
          SetWindowPos(FHorzScrollWnd.Handle, HWND_TOP, CtrlRect.Left + Left,
            CtrlRect.Top + Top, Right - Left, Bottom - Top, SWP_SHOWWINDOW);
    end;
  end;
end;

procedure TScrollingStyleHookPatch.DrawVertScroll(DC: HDC);
var
  B: TBitmap;
  Details: TThemedElementDetails;
  R: TRect;
begin
  if Handle = 0 then Exit;
  if DC = 0 then Exit;

  if VertScrollRect.Width > 0 then
  begin
    B := TBitmap.Create;
    try
      B.Width := VertScrollRect.Width;
      B.Height := VertScrollRect.Height;
      MoveWindowOrg(B.Canvas.Handle, -VertScrollRect.Left, -VertScrollRect.Top);
      if StyleServices.Available then
      begin
        R := VertScrollRect;
        R.Top := VertUpButtonRect.Bottom;
        R.Bottom := VertDownButtonRect.Top;
        if R.Height > 0 then
        begin
          Details := StyleServices.GetElementDetails(tsUpperTrackVertNormal);
          StyleServices.DrawElement(B.Canvas.Handle, Details, R);
        end;

        if VertSliderRect.Height > 0 then
        begin
          Details := StyleServices.GetElementDetails(VertSliderState);
          StyleServices.DrawElement(B.Canvas.Handle, Details, VertSliderRect);
        end;

        if VertSliderRect.Height <> 0 then
          Details := StyleServices.GetElementDetails(FVertUpState)
        else
          Details := StyleServices.GetElementDetails(tsArrowBtnUpDisabled);
        StyleServices.DrawElement(B.Canvas.Handle, Details, VertUpButtonRect);

        if VertSliderRect.Height <> 0 then
          Details := StyleServices.GetElementDetails(FVertDownState)
        else
          Details := StyleServices.GetElementDetails(tsArrowBtnDownDisabled);
        StyleServices.DrawElement(B.Canvas.Handle, Details, VertDownButtonRect);
      end;
      MoveWindowOrg(B.Canvas.Handle, VertScrollRect.Left, VertScrollRect.Top);
      with VertScrollRect do
        BitBlt(DC, Left, Top, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      B.Free;
    end;
  end;
end;

procedure TScrollingStyleHookPatch.DrawHorzScroll(DC: HDC);
var
  B: TBitmap;
  Details: TThemedElementDetails;
  R: TRect;
begin
  if Handle = 0 then Exit;
  if DC = 0 then Exit;

  if HorzScrollRect.Height > 0 then
  begin
    B := TBitmap.Create;
    try
      B.Width := HorzScrollRect.Width;
      B.Height := HorzScrollRect.Height;
      MoveWindowOrg(B.Canvas.Handle, -HorzScrollRect.Left, -HorzScrollRect.Top);
      if StyleServices.Available then
      begin
        R := HorzScrollRect;
        R.Left := HorzUpButtonRect.Right;
        R.Right := HorzDownButtonRect.Left;
        if R.Height > 0 then
        begin
          Details := StyleServices.GetElementDetails(tsUpperTrackHorzNormal);
          StyleServices.DrawElement(B.Canvas.Handle, Details, R);
        end;

        if HorzSliderRect.Height > 0 then
        begin
          Details := StyleServices.GetElementDetails(FHorzSliderState);
          StyleServices.DrawElement(B.Canvas.Handle, Details, HorzSliderRect);
        end;

        if HorzSliderRect.Height > 0 then
          Details := StyleServices.GetElementDetails(FHorzUpState)
        else
          Details := StyleServices.GetElementDetails(tsArrowBtnLeftDisabled);
        StyleServices.DrawElement(B.Canvas.Handle, Details, HorzUpButtonRect);

        if HorzSliderRect.Height > 0 then
          Details := StyleServices.GetElementDetails(FHorzDownState)
        else
          Details := StyleServices.GetElementDetails(tsArrowBtnRightDisabled);
        StyleServices.DrawElement(B.Canvas.Handle, Details, HorzDownButtonRect);
      end;
      MoveWindowOrg(B.Canvas.Handle, HorzScrollRect.Left, HorzScrollRect.Top);
      with HorzScrollRect do
        BitBlt(DC, Left, Top, B.Width, B.Height,
          B.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      B.Free;
    end;
  end;
end;

function TScrollingStyleHookPatch.GetVertDownButtonRect: TRect;
begin
  Result := VertScrollRect;
  if Result.Width > 0 then
    Result.Top := Result.Bottom - GetSystemMetrics(SM_CYVTHUMB)
  else
    Result := Rect(0, 0, 0, 0);
end;

function TScrollingStyleHookPatch.GetVertScrollRect: TRect;
var
  P: TPoint;
  BarInfo: TScrollBarInfo;
begin
  BarInfo.cbSize := SizeOf(BarInfo);
  GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), BarInfo);
  if STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0 then
    Result := Rect(0, 0, 0, 0)
  else
  begin
    P := BarInfo.rcScrollBar.TopLeft;
    ScreenToClient(Handle, P);
    Result.TopLeft := P;
    P := BarInfo.rcScrollBar.BottomRight;
    ScreenToClient(Handle, P);
    Result.BottomRight := P;
//    if HasBorder then
//      if HasClientEdge then
//         OffsetRect(Result, 2, 2)
//       else
//         OffsetRect(Result, 1, 1);
  end;
end;

function TScrollingStyleHookPatch.GetVertSliderRect: TRect;
var
  P: TPoint;
  BarInfo: TScrollBarInfo;
begin
  BarInfo.cbSize := SizeOf(BarInfo);
  GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), BarInfo);
  if (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0) or
     (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0) then
    Result := Rect(0, 0, 0, 0)
  else
  begin
    P := BarInfo.rcScrollBar.TopLeft;
    ScreenToClient(Handle, P);
    Result.TopLeft := P;
    P := BarInfo.rcScrollBar.BottomRight;
    ScreenToClient(Handle, P);
    Result.BottomRight := P;
    Result.Top := BarInfo.xyThumbTop + 0;
    Result.Bottom := BarInfo.xyThumbBottom + 0;
//    if HasBorder then
//      if HasClientEdge then
//        OffsetRect(Result, 2, 2)
//      else
//        OffsetRect(Result, 1, 1);
  end;
end;

function TScrollingStyleHookPatch.GetVertTrackRect: TRect;
begin
  Result := VertScrollRect;
  if Result.Width > 0 then
  begin
    Result.Top := Result.Top + GetSystemMetrics(SM_CYVTHUMB);
    Result.Bottom := Result.Bottom - GetSystemMetrics(SM_CYVTHUMB);
  end
  else
    Result := Rect(0, 0, 0, 0);
end;

function TScrollingStyleHookPatch.GetVertUpButtonRect: TRect;
begin
  Result := VertScrollRect;
  if Result.Width > 0 then
    Result.Bottom := Result.Top + GetSystemMetrics(SM_CYVTHUMB)
  else
    Result := Rect(0, 0, 0, 0);
end;

function TScrollingStyleHookPatch.GetHorzDownButtonRect: TRect;
begin
  Result := HorzScrollRect;
  if Result.Height > 0 then
    Result.Left := Result.Right - GetSystemMetrics(SM_CXHTHUMB)
  else
    Result := Rect(0, 0, 0, 0);
end;

function TScrollingStyleHookPatch.GetHorzScrollRect: TRect;
var
  P: TPoint;
  BarInfo: TScrollBarInfo;
begin
  BarInfo.cbSize := SizeOf(BarInfo);
  GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), BarInfo);
  if STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0 then
    Result := Rect(0, 0, 0, 0)
  else
  begin
    P := BarInfo.rcScrollBar.TopLeft;
    ScreenToClient(Handle, P);
    Result.TopLeft := P;
    P := BarInfo.rcScrollBar.BottomRight;
    ScreenToClient(Handle, P);
    Result.BottomRight := P;
//    if HasBorder then
//      if HasClientEdge then
//        OffsetRect(Result, 2, 2)
//      else
//        OffsetRect(Result, 1, 1);
  end;
end;

function TScrollingStyleHookPatch.GetHorzSliderRect: TRect;
var
  P: TPoint;
  BarInfo: TScrollBarInfo;
begin
  BarInfo.cbSize := SizeOf(BarInfo);
  GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), BarInfo);
  if (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0) or
     (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0) then
    Result := TRect.Create(0, 0, 0, 0)
  else
  begin
    P := BarInfo.rcScrollBar.TopLeft;
    ScreenToClient(Handle, P);
    Result.TopLeft := P;
    P := BarInfo.rcScrollBar.BottomRight;
    ScreenToClient(Handle, P);
    Result.BottomRight := P;
    Result.Left := BarInfo.xyThumbTop + 0;
    Result.Right := BarInfo.xyThumbBottom + 0;
//    if HasBorder then
//      if HasClientEdge then
//        OffsetRect(Result, 2, 2)
//      else
//        OffsetRect(Result, 1, 1);
  end;
end;

function TScrollingStyleHookPatch.GetHorzTrackRect: TRect;
begin
  Result := HorzScrollRect;
  if Result.Width > 0 then
  begin
    Result.Left := Result.Left + GetSystemMetrics(SM_CXHTHUMB);
    Result.Right := Result.Right - GetSystemMetrics(SM_CXHTHUMB);
  end
  else
    Result := Rect(0, 0, 0, 0);
end;

function TScrollingStyleHookPatch.GetHorzUpButtonRect: TRect;
begin
  Result := HorzScrollRect;
  if Result.Height > 0 then
  begin
    Result.Right := Result.Left + GetSystemMetrics(SM_CXHTHUMB);
  end
  else
    Result := Rect(0, 0, 0, 0);
end;

procedure TScrollingStyleHookPatch.DrawBorder;
begin
 if StyleServices.Available then
   StyleServices.PaintBorder(Control, True);
end;

procedure TScrollingStyleHookPatch.PaintScroll;
begin
  if FInitingScrollBars then Exit;
  if FVertScrollWnd <> nil then
    FVertScrollWnd.Repaint;
  if FHorzScrollWnd <> nil then
    FHorzScrollWnd.Repaint;
end;

procedure TScrollingStyleHookPatch.WMHScroll(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMVScroll(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMMouseWheel(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMCaptureChanged(var Msg: TMessage);
begin
  if FVertUpState = tsArrowBtnUpPressed then
  begin
    FVertUpState := tsArrowBtnUpNormal;
    PaintScroll;
  end;

  if FVertDownState = tsArrowBtnDownPressed then
  begin
    FVertDownState := tsArrowBtnDownNormal;
    PaintScroll;
  end;

  if FHorzUpState = tsArrowBtnLeftPressed then
  begin
    FHorzUpState := tsArrowBtnLeftNormal;
    PaintScroll;
  end;

  if FHorzDownState = tsArrowBtnRightPressed then
  begin
    FHorzDownState := tsArrowBtnRightNormal;
    PaintScroll;
  end;

  CallDefaultProc(TMessage(Msg));
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMNCLButtonDown(var Msg: TWMMouse);
var
  P: TPoint;
  SF: TScrollInfo;
begin
  P := Point(Msg.XPos, Msg.YPos);
  ScreenToClient(Handle, P);

  if HasBorder then
    if HasClientEdge then
    begin
      P.X := P.X + 2;
      P.Y := P.Y + 2;
    end
    else
    begin
      P.X := P.X + 1;
      P.Y := P.Y + 1;
    end;

  if VertSliderRect.Contains(P) then
  begin
    FLeftButtonDown := True;
    SF.fMask := SIF_ALL;
    SF.cbSize := SizeOf(SF);
    GetScrollInfo(Handle, SB_VERT, SF);
    FListPos := SF.nPos;
    FScrollPos := SF.nPos;
    FPrevScrollPos := Mouse.CursorPos.Y;
    FVertSliderState := tsThumbBtnVertPressed;
    PaintScroll;
    SetCapture(Handle);
    Handled := True;
    Exit;
  end;

  if HorzSliderRect.Contains(P) then
  begin
    FLeftButtonDown := True;
    SF.fMask := SIF_ALL;
    SF.cbSize := SizeOf(SF);
    GetScrollInfo(Handle, SB_HORZ, SF);
    FListPos := SF.nPos;
    FScrollPos := SF.nPos;
    FPrevScrollPos := Mouse.CursorPos.X;
    FHorzSliderState :=  tsThumbBtnHorzPressed;
    PaintScroll;
    SetCapture(Handle);
    Handled := True;
    Exit;
  end;

  if VertDownButtonRect.Contains(P) and (VertSliderRect.Height > 0) then
    FVertDownState := tsArrowBtnDownPressed;

  if VertUpButtonRect.Contains(P) and (VertSliderRect.Height > 0) then
    FVertUpState := tsArrowBtnUpPressed;

  if HorzDownButtonRect.Contains(P) and (HorzSliderRect.Width > 0)  then
    FHorzDownState := tsArrowBtnRightPressed;

  if HorzUpButtonRect.Contains(P) and (HorzSliderRect.Width > 0) then
    FHorzUpState := tsArrowBtnLeftPressed;

  PaintScroll;
end;

procedure TScrollingStyleHookPatch.WMNCLButtonDblClk(var Msg: TWMMouse);
begin
  WMNCLButtonDown(Msg);
end;

procedure TScrollingStyleHookPatch.WMNCLButtonUp(var Msg: TWMMouse);
var
  P: TPoint;
begin
  P := Point(Msg.XPos, Msg.YPos);
  ScreenToClient(Handle, P);

  if HasBorder then
    if HasClientEdge then
    begin
      P.X := P.X + 2;
      P.Y := P.Y + 2;
    end
    else
    begin
      P.X := P.X + 1;
      P.Y := P.Y + 1;
    end;

  if VertSliderState =  tsThumbBtnVertPressed then
  begin
    FLeftButtonDown := False;
    FVertSliderState := tsThumbBtnVertNormal;
    PaintScroll;
    Handled := True;
    Exit;
  end;

  if FHorzSliderState = tsThumbBtnHorzPressed then
  begin
    FLeftButtonDown := False;
    FHorzSliderState := tsThumbBtnHorzNormal;
    PaintScroll;
    Handled := True;
    Exit;
  end;

  if VertSliderRect.Height > 0 then
    if VertDownButtonRect.Contains(P) then
      FVertDownState := tsArrowBtnDownHot
    else
      FVertDownState := tsArrowBtnDownNormal;

  if VertSliderRect.Height > 0 then
    if VertUpButtonRect.Contains(P) then
      FVertUpState := tsArrowBtnUpHot
    else
      FVertUpState := tsArrowBtnUpNormal;

  if HorzSliderRect.Width > 0 then
    if HorzDownButtonRect.Contains(P) then
      FHorzDownState := tsArrowBtnRightHot
    else
      FHorzDownState := tsArrowBtnRightNormal;

  if HorzSliderRect.Width > 0 then
    if HorzUpButtonRect.Contains(P) then
      FHorzUpState := tsArrowBtnLeftHot
    else
      FHorzUpState := tsArrowBtnLeftNormal;

  CallDefaultProc(TMessage(Msg));
  if (HorzSliderRect.Width > 0) or (VertSliderRect.Height > 0) then
    PaintScroll;
  Handled := True;
end;


procedure TScrollingStyleHookPatch.WMNCMouseMove(var Msg: TWMMouse);
var
  P: TPoint;
  MustUpdateScroll: Boolean;
begin
  inherited;
  P := Point(Msg.XPos, Msg.YPos);
  ScreenToClient(Handle, P);

  if HasBorder then
    if HasClientEdge then
    begin
      P.X := P.X + 2;
      P.Y := P.Y + 2;
    end
    else
    begin
      P.X := P.X + 1;
      P.Y := P.Y + 1;
    end;

  MustUpdateScroll := False;

  if VertSliderRect.Height > 0 then
  if VertSliderRect.Contains(P) and (VertSliderState = tsThumbBtnVertNormal) then
  begin
    FVertSliderState := tsThumbBtnVertHot;
    MustUpdateScroll := True;
  end
  else
    if not VertSliderRect.Contains(P) and (VertSliderState = tsThumbBtnVertHot) then
    begin
      FVertSliderState := tsThumbBtnVertNormal;
      MustUpdateScroll := True;
    end;

  if HorzSliderRect.Width > 0 then
    if HorzSliderRect.Contains(P) and (FHorzSliderState = tsThumbBtnHorzNormal) then
    begin
      FHorzSliderState := tsThumbBtnHorzHot;
      MustUpdateScroll := True;
    end
    else
      if not HorzSliderRect.Contains(P) and (FHorzSliderState = tsThumbBtnHorzHot) then
      begin
        FHorzSliderState := tsThumbBtnHorzNormal;
        MustUpdateScroll := True;
      end;

  if VertSliderRect.Height > 0 then
    if VertDownButtonRect.Contains(P) and (FVertDownState = tsArrowBtnDownNormal) then
    begin
      FVertDownState := tsArrowBtnDownHot;
      MustUpdateScroll := True;
    end
    else
      if not VertDownButtonRect.Contains(P) and (FVertDownState = tsArrowBtnDownHot) then
      begin
        FVertDownState := tsArrowBtnDownNormal;
        MustUpdateScroll := True;
      end;

  if VertSliderRect.Height > 0 then
    if VertUpButtonRect.Contains(P) and (FVertUpState = tsArrowBtnUpNormal) then
    begin
      FVertUpState := tsArrowBtnUpHot;
      MustUpdateScroll := True;
    end
    else if not VertUpButtonRect.Contains(P) and (FVertUpState = tsArrowBtnUpHot) then
    begin
      FVertUpState := tsArrowBtnUpNormal;
      MustUpdateScroll := True;
    end;

  if HorzSliderRect.Width > 0 then
    if HorzDownButtonRect.Contains(P) and (FHorzDownState = tsArrowBtnRightNormal) then
    begin
      FHorzDownState := tsArrowBtnRightHot;
      MustUpdateScroll := True;
    end
    else if not HorzDownButtonRect.Contains(P) and (FHorzDownState = tsArrowBtnRightHot) then
    begin
      FHorzDownState := tsArrowBtnRightNormal;
      MustUpdateScroll := True;
    end;

  if HorzSliderRect.Width > 0 then
    if HorzUpButtonRect.Contains(P) and (FHorzUpState = tsArrowBtnLeftNormal) then
    begin
      FHorzUpState := tsArrowBtnLeftHot;
      MustUpdateScroll := True;
    end
    else if not HorzUpButtonRect.Contains(P) and (FHorzUpState = tsArrowBtnLeftHot) then
    begin
      FHorzUpState := tsArrowBtnLeftNormal;
      MustUpdateScroll := True;
    end;

  if MustUpdateScroll then
    PaintScroll;
end;

procedure TScrollingStyleHookPatch.WMLButtonUp(var Msg: TWMMouse);
begin
  if VertSliderState = tsThumbBtnVertPressed then
  begin
    PostMessage(Handle, WM_VSCROLL, Integer(SmallPoint(SB_ENDSCROLL, 0)), 0);
    FLeftButtonDown := False;
    FVertSliderState := tsThumbBtnVertNormal;
    PaintScroll;
    Handled := True;
    ReleaseCapture;
    Exit;
  end;

  if FHorzSliderState = tsThumbBtnHorzPressed then
  begin
    PostMessage(Handle, WM_HSCROLL, Integer(SmallPoint(SB_ENDSCROLL, 0)), 0);
    FLeftButtonDown := False;
    FHorzSliderState := tsThumbBtnHorzNormal;
    PaintScroll;
    Handled := True;
    ReleaseCapture;
    Exit;
  end;

  if FVertUpState = tsArrowBtnUpPressed then
    FVertUpState := tsArrowBtnUpNormal;

  if FVertDownState = tsArrowBtnDownPressed then
    FVertDownState := tsArrowBtnDownNormal;

  if FHorzUpState = tsArrowBtnLeftPressed then
    FHorzUpState := tsArrowBtnLeftNormal;

  if FHorzDownState = tsArrowBtnRightPressed then
    FHorzDownState := tsArrowBtnRightNormal;

  FLeftButtonDown := False;
  PaintScroll;
end;

procedure TScrollingStyleHookPatch.WMMouseMove(var Msg: TWMMouse);
var
  SF: TScrollInfo;
begin
  inherited;

  if VertSliderState = tsThumbBtnVertPressed then
  begin
    SF.fMask := SIF_ALL;
    SF.cbSize := SizeOf(SF);
    GetScrollInfo(Handle, SB_VERT, SF);
    if SF.nPos <> Round(FScrollPos) then FScrollPos := SF.nPos;

    FScrollPos := FScrollPos + (SF.nMax - SF.nMin) * ((Mouse.CursorPos.Y - FPrevScrollPos) / VertTrackRect.Height);
    if FScrollPos < SF.nMin then FScrollPos := SF.nMin;
    if FScrollPos > SF.nMax then FScrollPos := SF.nMax;
    if SF.nPage <> 0 then
      if Round(FScrollPos) > SF.nMax - Integer(SF.nPage) + 1 then
        FScrollPos := SF.nMax - Integer(SF.nPage) + 1;
    FPrevScrollPos := Mouse.CursorPos.Y;
    SF.nPos := Round(FScrollPos);

    SetScrollInfo(Handle, SB_VERT, SF, False);
    PostMessage(Handle, WM_VSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Round(FScrollPos))), 0);

    PaintScroll;
    Handled := True;
    Exit;
  end;

  if FHorzSliderState = tsThumbBtnHorzPressed then
  begin
    SF.fMask := SIF_ALL;
    SF.cbSize := SizeOf(SF);
    GetScrollInfo(Handle, SB_HORZ, SF);
    if SF.nPos <> Round(FScrollPos) then FScrollPos := SF.nPos;

    FScrollPos := FScrollPos + (SF.nMax - SF.nMin) * ((Mouse.CursorPos.X - FPrevScrollPos) / HorzTrackRect.Width);
    if FScrollPos < SF.nMin then FScrollPos := SF.nMin;
    if FScrollPos > SF.nMax then FScrollPos := SF.nMax;
    if SF.nPage <> 0 then
      if Round(FScrollPos) > SF.nMax - Integer(SF.nPage) + 1 then
        FScrollPos := SF.nMax - Integer(SF.nPage) + 1;
    FPrevScrollPos := Mouse.CursorPos.X;
    SF.nPos := Round(FScrollPos);

    SetScrollInfo(Handle, SB_HORZ, SF, False);
    PostMessage(Handle, WM_HSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Round(FScrollPos))), 0);

    PaintScroll;
    Handled := True;
    Exit;
  end;

  if (FHorzSliderState <> tsThumbBtnHorzPressed) and (FHorzSliderState = tsThumbBtnHorzHot) then
  begin
    FHorzSliderState := tsThumbBtnHorzNormal;
    PaintScroll;
  end;

  if (VertSliderState <> tsThumbBtnVertPressed) and (VertSliderState = tsThumbBtnVertHot) then
  begin
    FVertSliderState := tsThumbBtnVertNormal;
    PaintScroll;
  end;

  if (FHorzUpState <> tsArrowBtnLeftPressed) and (FHorzUpState = tsArrowBtnLeftHot) then
  begin
    FHorzUpState := tsArrowBtnLeftNormal;
    PaintScroll;
  end;

  if (FHorzDownState <> tsArrowBtnRightPressed) and (FHorzDownState =tsArrowBtnRightHot) then
  begin
    FHorzDownState := tsArrowBtnRightNormal;
    PaintScroll;
  end;

  if (FVertUpState <> tsArrowBtnUpPressed) and (FVertUpState = tsArrowBtnUpHot) then
  begin
    FVertUpState := tsArrowBtnUpNormal;
    PaintScroll;
  end;

  if (FVertDownState <> tsArrowBtnDownPressed) and (FVertDownState = tsArrowBtnDownHot) then
  begin
    FVertDownState := tsArrowBtnDownNormal;
    PaintScroll;
  end;

  CallDefaultProc(TMessage(Msg));
  if FLeftButtonDown then
    PaintScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMKeyDown(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMKeyUp(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMLButtonDown(var Msg: TWMMouse);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.Paint(Canvas: TCanvas);
begin
  PaintScroll;
end;

procedure TScrollingStyleHookPatch.PaintBackground(Canvas: TCanvas);
begin
  inherited PaintBackground(Canvas);
  PaintScroll;
end;

function TScrollingStyleHookPatch.GetParentBounds: TRect;
begin
  if (Control <> nil) and (Control.Parent <> nil) then
    Result := Control.Parent.BoundsRect
  else if Handle <> 0 then
    GetWindowRect(Control.ParentWindow, Result)
  else
    Result := TRect.Empty;
end;

procedure TScrollingStyleHookPatch.WMClose(var Msg: TWMCLOSE);
begin
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMShowWindow(var Msg: TWMShowWindow);
begin
  CallDefaultProc(TMessage(Msg));

  if (FVertScrollWnd <> nil) and FVertScrollWnd.HandleAllocated then
    if Msg.Show then
      ShowWindow(FVertScrollWnd.Handle, SW_SHOW)
    else
      ShowWindow(FVertScrollWnd.Handle, SW_HIDE);

  if (FHorzScrollWnd <> nil) and FHorzScrollWnd.HandleAllocated then
    if Msg.Show then
      ShowWindow(FHorzScrollWnd.Handle, SW_SHOW)
    else
      ShowWindow(FHorzScrollWnd.Handle, SW_HIDE);

  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMWindowPosChanged;
begin
  CallDefaultProc(TMessage(Msg));
  if Msg.WindowPos.Flags and SWP_HIDEWINDOW = SWP_HIDEWINDOW then
  begin
    if FVertScrollWnd <> nil then
      ShowWindow(FVertScrollWnd.Handle, SW_HIDE);
    if FHorzScrollWnd <> nil then
      ShowWindow(FHorzScrollWnd.Handle, SW_HIDE);
  end
  else
    if IsWindowVisible(Control.Handle) then
      UpdateScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WndProc(var Message: TMessage);
begin
  // Reserved for potential updates
  inherited;
end;

procedure TScrollingStyleHookPatch.CMVisibleChanged(var Msg: TMessage);
begin
  if Control.HandleAllocated then
  begin
    if FVertScrollWnd <> nil then
      if (Control.Visible) then
        ShowWindow(FVertScrollWnd.Handle, SW_SHOW)
      else
        ShowWindow(FVertScrollWnd.Handle, SW_HIDE);

    if FHorzScrollWnd <> nil then
      if (Control.Visible) then
        ShowWindow(FHorzScrollWnd.Handle, SW_SHOW)
      else
        ShowWindow(FHorzScrollWnd.Handle, SW_HIDE);
  end;
  Handled := False;
end;

procedure TScrollingStyleHookPatch.WMMove(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  UpdateScroll;
  Handled := True;
end;

procedure TScrollingStyleHookPatch.WMSize(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  UpdateScroll;
  Handled := True;
end;


{ TScrollingStyleHook.TScrollWindow }

constructor TScrollingStyleHookPatch.TScrollWindow.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csOverrideStylePaint];
  FStyleHook := nil;
end;

procedure TScrollingStyleHookPatch.TScrollWindow.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_CHILDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
  Params.ExStyle := Params.ExStyle or WS_EX_NOPARENTNOTIFY;
  Params.WindowClass.style := Params.WindowClass.style;
  if (FStyleHook <> nil) and FStyleHook.IsPopupWindow then
    Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
end;

procedure TScrollingStyleHookPatch.TScrollWindow.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  Msg.Result := HTTRANSPARENT;
end;

procedure TScrollingStyleHookPatch.TScrollWindow.WMPaint(var Msg: TWMPaint);
var
  PS: TPaintStruct;
  DC: HDC;
begin
  BeginPaint(Handle, PS);
  try
    if FStyleHook <> nil then
    begin
      DC := GetWindowDC(Handle);
      try
        if FVertical then
        begin
          with FStyleHook.VertScrollRect do
            MoveWindowOrg(DC, -Left, -Top);
          FStyleHook.DrawVertScroll(DC);
        end
        else
        begin
          with FStyleHook.HorzScrollRect do
            MoveWindowOrg(DC, -Left, -Top);
          FStyleHook.DrawHorzScroll(DC);
        end;
      finally
        ReleaseDC(Handle, DC);
      end;
    end;
  finally
    EndPaint(Handle, PS);
  end;
end;

procedure TScrollingStyleHookPatch.TScrollWindow.WndProc(var Message: TMessage);
begin
  // Reserved for potential updates
  inherited;
end;

procedure TScrollingStyleHookPatch.TScrollWindow.WMEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := 1;
end;


end.
